Power Programmierung/Power-Programmierung (Tewi)(1994).iso/magazine/dbms_mag/9104/cblocks.txt

Text File | 1991-03-01 | 40KB | 971 lines

                5.0 FOCUS: Code Blocks for Blockheads, Part 1
                                 By Greg Lief

Introduction

Now that we have all had more time to play with Clipper 5.0, this
is an appropriate time to talk more about code blocks, along with some
5.0 functions that use them.

Last month we talked about code block basics.  We also looked at some
of the basic code block functions (EVAL(), AEVAL(), ASORT(), ASCAN(),
and DBEVAL()).  There are several other new functions that use these
creatures, and we will look at them now in excruciating detail. We
will also discuss an intriguing method of passing local variables to
another function with code blocks.


Code Blocks Laid Bare

Code blocks are a new datatype that contains compiled Clipper code.
They can be compiled either at compile-time with the rest of your
Clipper code, or at run-time with the use of the & operator.
(Yes, Virginia, I know this does not make a lot of sense, but there
are plenty of examples to follow.)

This is a code block in its rawest form:

            { | [<argument list>] | <expression list> }

Code blocks look quite similar to Clipper 5.0 arrays.  Both code
blocks and arrays begin with an open curly brace ("{") and end with a
closed curly brace ("}").  But code blocks differentiate themselves by
including two "pipe" characters ("|") directly after the opening
brace.  You may optionally include an <argument list> between these
pipe characters, which would then be passed to the code block upon
evaluation.  The <argument list> should be comma delimited (e.g.,
"a, b, c...").

Although white space between the pipe characters and braces is purely
optional, I highly recommend you use it for the sake of readability.

The <expression list> is, obviously enough, a comma-delimited list of
any valid Clipper expressions.  These can run the gamut, as you
will quickly discover.


How to Write a Code Block

There are three methods in which to write a code block:

   a) To be compiled into a code block at compile-time, for example:

      local myblock := { | | fname }

   b) As a character string, which can be compiled to a code block at
      run time.  For such compilation you can use the & operator
      (yes, the same one that is used for macros).  But remember that
      this is not the same thing as macro substitution!

      Suppose that we wanted to set up a TBrowse() object to browse a
      database.  We would need to establish a column for each field in
      the database.  When setting up TBrowse() columns, we must
      specify a code block, which when evaluated, contains the
      contents of that column.  If we knew in advance that our
      database contained the fields FNAME, LNAME, and SSN, it would be
      a simple matter to write the code blocks so that they could be
      compiled at compile-time:

      local x, browse := TBrowseNew(3, 19, 15, 60), column
      use test
      column := TBColumnNew("FNAME", { | | fname } )
      browse:AddColumn( column )
      column := TBColumnNew("LNAME", { | | lname } )
      browse:AddColumn( column )
      column := TBColumnNew("SSN", { | | ssn } )
      browse:AddColumn( column )

      However, let us further suppose that we wish this routine to be
      generic.  We therefore cannot hard-code field names, because the
      structure will be unknown until run-time.  Here's how we would
      approach it:

      local x, browse := TBrowseNew(3, 19, 15, 60), column
      use test
      for x := 1 to fcount()
         column := TBColumnNew(field(x), &("{ | | " + field(x) + "}"))
         browse:AddColumn( column )
      next

      The Clipper FIELD() function returns the name of the field based
      at the ordinal position in the database structure.  For example,
      FIELD(2) will return the name of the second field in the
      database ("LNAME" in our little example).

   c) Cower in fear at the mention of the words "code block", and let
      the preprocessor write them all for you.  For example, if you
      write the following code:

      index on fname to customer

      lo and behold!  The preprocessor will dedicate a code block in
      your honor:

      __dbCreatIndex( "temp", "fname", {|| fname}, if(.F., .T., NIL))

      Code blocks have much in common with inner city cockroaches: you
      cannot neither run nor hide from them.  Thankfully, code blocks
      are a lot more fun and a million times more useful than
      cockroaches, which is why if you have read this far, you should
      keep reading and stop playing with your pet cockroach.


Evaluating Code Blocks

The only operation that you can perform on a code block is evaluation.
You can think of evaluation as being analagous to calling a function
and returning a value from it.  Code blocks are evaluated by the
EVAL(), AEVAL(), or DBEVAL() functions.  They are also evaluated
internally when you pass them as parameters to functions that can use
them.  When evaluated, code blocks return the value of the rightmost
expression within them.  For example, if you create the following code
block:

   local myblock := { | | mvar }

when you EVALuate this code block, it will return the value of MVAR.

   local myblock := { | | mvar }, mvar := 500, x
   x := eval(myblock)
   ? x                        // output: 500

Remember that code blocks can contain any valid Clipper expressions.
This means that you can get considerably fancier with them.  For
example:

   local myblock := { | | qout(var1), qqout(var2), 500 }
   local var1 := "Mister ", var2 := "Grump"
   x := eval(myblock)              // output: "Mister Grump"
   ? x                             // output: 500

Look again at that last statement.  How does X get the value of 500?
When you evaluate a code block, it returns the value of the last (or
rightmost) expression within it.  Because the last expression in
MYBLOCK was 500, the variable X assumed that value.


Using Code Blocks Without Parameters

These are examples of simple code blocks that do not use parameters:

   local myblock := { | | qout(mvar) }, mvar := "testing"
   eval(myblock)    // output: "testing"

   local myblock := { | | 5000 }
   x := eval(myblock)
   ? x              // output: 5000

   local myblock := { | | x++ }
   for y := 1 to 100
      eval(myblock) // crashes because X has not been defined
   next
   ? x

   local myblock := { | | x++ }, x := 1  // much nicer thanks
   for y := 1 to 100
      eval(myblock)
   next
   ? x              // output: 101

   local myblock := { | | BlueFunc() }
   eval(myblock)   // calls BlueFunc() which displays a message
   return nil

   static function bluefunc
   ? "here we are in a BlueFunc() - will we ever escape?"
   inkey(5)
   return nil


Using Code Blocks with Parameters

Just as with functions, there is far greater power to harness with
code blocks when you begin passing parameters.  Writing a parameter
list for a code block is nearly identical to writing one for a
function.  However, because it is harder to conceptualize in the
linear world of a code block, let's write a simple code block and then
rewrite it as a function:

   local myblock := { | a, b, c | max(a, max(b, c)) }

   function mmax(a, b, c)
   return max(a, max(b, c))

As you can readily see, the function MMax() returns the highest of the
three parameters passed to it.  Evaluating the code block MyBlock will
return exactly the same thing.  However, we must first slip past
another stumbling block: namely, how to pass parameters to a code
block.  It is actually quite simple; the EVAL() function accepts
optional parameters after the name of the code block.  Each such
optional parameter represents a parameter to be passed to the code
block.  For example, if you write:

   eval(myblock, 20)

you are passing the numeric parameter 20 to the code block defined as
MyBlock.  Let's have another look at our MMAX() function and code
block so that you can get a feel for passing parameters with EVAL():

   local myblock := { | a, b, c | max(a, max(b, c)) }
   ? mmax(20, 100, 30)             // output: 100
   ? eval(myblock, 20, 100, 30)    // output: 100

Do you remember the BlueFunc() that we were just in?  (I'm feeling
much better now, thank you.)  Whaddaya say we modify the function and
the code block to accept a parameter which will dictate how long to
wait for a keypress?

   local myblock := { | x | BlueFunc(x) }
   eval(myblock, 20)   // calls BlueFunc() and will wait 20 seconds
   return nil

   static function bluefunc(delay)
   ? "we're in a BlueFunc() for " + ltrim(str(delay)) + " seconds"
   inkey(delay)
   return nil

Here is a code block that accepts up to three parameters and displays
them on the screen.

   local myblock := { | a, b, c | qout(a, b, c) }
   eval(myblock, 1, 2, 3)       // output: 1 2 3
   x := eval(myblock, 1, 2)     // output: 1 2 NIL
   ? x                          // output: NIL

You already know why the second EVAL() statement outputs 1, 2, and
NIL, right?  It is because any declared parameters that are not
received are initialized to NIL (see my article in the December 1990
Aquarium on the subject of NIL).  Because MyBlock expects three
parameters (A, B, C), and we only pass two, C gets initialized to NIL.
Trick question: do you know why X takes the value of NIL?  No, it has
nothing to do with the fact that we passed too few parameters. Rather,
it is because the code block returns the value of the expression
QOut(a, b, c).  The QOut() function always returns NIL.  (If you
already knew this, give yourself a pat on the back but do not break
your arm in the process!)

Important Note: any arguments that you specify in a code block
are automatically given LOCAL scope.  Such arguments will not be
visible to any nested code blocks!  This merits another example:

   local firstblock := { | | qout(x) }
   local myblock := { | x | x++, eval(firstblock) }
   eval(myblock, 3)

This program will crash when you attempt to EVALuate FirstBlock().
It does seem that the argument X in MyBlock() should be visible within
FirstBlock().  But X is LOCAL to MyBlock() and is therefore NOT
visible to FirstBlock().


Functions That Crave Code Blocks

EVAL(<block>, [<arg list>])

   You should have already surmised that EVAL() evaluates a code
   block, which you pass to it as the <block> parameter.  The optional
   parameter <arg list> is a comma-delimited list of parameters to be
   passed to the code block when you evaluate it.

   Return value: EVAL() returns the value of the last (rightmost)
   expression within the block.

AEVAL(<array>, <block>, [<start>], [<count>])

   AEVAL() is similar to EVAL() but is specially designed to work with
   arrays.  It evaluates a code block (specified by the <block>
   parameter) for each element in the array (specified by the <array>
   parameter).  You may optionally specify a <start> element, and a
   number of elements (<count>) to process.  If you do not use these
   optional parameters, AEVAL() will begin with the first element in
   the array and process all of them.

   The following AEVAL() is a real workhorse; it determines the
   maximum, minimum, and sum of all elements in the array MyArray:

   local myarray := { 75, 100, 2, 200, .25, -25, 40, 52 }, ;
         nmax, nmin, nsum := 0
   nmax := nmin := myarray[1]
   aeval(myarray, { | a | nmax := max(nmax, a), nmin := min(nmin, a),;
                          nsum += a } )
   ? "Maximum value:", nmax         // 200
   ? "Minimum value:", nmin         // -25
   ? "Total amount: ", nsum         // 444.25

   AEVAL() automatically passes two parameters to the code block:
   <value> and <number>.  <value> is the value of the array element
   being processed.  <number> is the number of the array element being
   processed.  You have already seen how <value> is used, but why
   should we bother with <number>?  Suppose that you want to increment
   each element in MyArray.  You would probably write your code block
   like this:

   aeval(myarray, { | a | a++ } )
   aeval(myarray, { | a | qout(a) } )

   Surprise, surprise!  This will not do a single thing to the
   elements of the array, because they are passed by value (not
   reference) to the code block.  Passing by value means that the
   code block makes a copy of the array element, and any manipulation
   done within the code block is performed on the copy rather than the
   genuine article.  Let's try it again with the <number> parameter:

   aeval(myarray, { | a, b | myarray[b]++ } )
   aeval(myarray, { | a | qout(a) } )

   Return value: AEVAL() returns a reference to the array you ask it
   to process.

DBEVAL(<block>, [<for>], [<while>], [<next>], [<record>], [<rest>])

   DBEVAL() is similar to AEVAL(), except that it deals with databases
   rather than arrays.  It also provides far greater control,
   including FOR, WHILE, NEXT, RECORD, and REST clauses.  If you look
   at the STD.CH header file, you will see that the COUNT, SUM, and
   AVERAGE commands, as well as the iterator versions of DELETE,
   RECALL, and REPLACE, are all preprocessed into calls to DBEVAL().
   For example, if you want to sum the field BALANCE for all records in
   your database, the following DBEVAL() would do the trick:

   ntotal := 0
   DBEval( { | | ntotal += balance} )

   You could easily modify this to keep track of the highest balance:

   ntotal := nmax := 0
   DBEval( { | | ntotal += balance, nmax := max(nmax, balance) } )
   ? "Total:  ", ntotal
   ? "Maximum:", nmax

   <block> is the code block to evaluate for each database record.
   There are a plethora of optional parameters.

   <for> and <while> are code blocks that correspond directly to the
   FOR and WHILE clauses. Basically, if you use either or both of
   these clauses, DBEVAL() will process records until the code blocks
   return False (.F.).

   <next> and <record> are both numerics; <next> specifies how many
   records to process from the current record, and <record> specifies
   which record number to process.

   <rest> is a logical that determines whether the DBEVAL() scope will
   be from the current record to the end-of-file, or all records.  If
   you pass True (.T.), DBEVAL() will assume that you prefer the
   former (i.e., start from current record).  If you pass False or
   ignore this parameter, DBEVAL() will process all records.

   Return Value:  DBEVAL() always returns NIL.

ASCAN(<array>, <value>, [<start>], [<count>])

   As in Summer '87, ASCAN() scans an array for a given <value>.
   However, the big difference is that you can now pass a code block
   as the <value>!  "Why would I want to do that?" you moan.  Off the
   top of my head comes one example: the case-insensitive ASCAN().
   Try it in Summer '87.  (I don't know how to simulate the passage of
   time in an article like this, but I'll give it my best shot!)

   (Three Hours Later)

   What?  You mean to tell me that you cannot do a case-insensitive
   ASCAN() in Summer '87?  Gee whiz, no wonder my users were having
   problems!  Thank goodness it takes nothing more than a well-placed
   code block in Clipper 5.0:

   ascan(myarray, { | a | upper(a) = upper("search value")} )

   This will scan MyArray and test the upper-case equivalent of each
   array element against the upper-case search value.  But before we
   move on, let's bullet-proof this code block.  Do you know what
   happens if you try to convert a non-character value with UPPER()?
   (The answer is... an unexpected DOS holiday.)  So let us ensure
   that each element thus tested is indeed a character string:

   ascan(array, { | a | if(valtype(a) == "C", ;
                        upper(a) = upper(value), .F.) } )

   An ounce of prevention is worth a day of debugging!

ASORT(<array>, [<start>], [<count>], [<block>])

   As in Summer '87, ASORT() sorts an array.  The optional parameters
   <start> and <count> are the same here as in AEVAL().  However, as
   with ASORT(), code blocks let you dramatically change the shape of
   things.  You could come up with any manner of arcane sorts: put
   all elements containing the word "Grump" at the top of the array
   (where they should rightfully be); descending order; alphabetical
   order based on the last letter in the word (!).

   Each time your code block is evaluated by ASORT(), the function
   passes two array elements to the block.  The block is then expected
   to compare them in some fashion that you specify, and return either
   True (.T.) if the elements are in proper order or False (.F.) if
   they are not.

   Here's a descending sort:

   local myarray := { "GREG", "JUSTIN", "JENNIFER", "TRACI", "DON" }
   asort(myarray,,, { | x, y | x > y } )
   aeval(myarray, { | a | qout(a) } )  // so you can see it worked!

   One situation where a code block sort would save the day is when
   you must sort a multi-dimensional array.  Let's fill an array with
   DIRECTORY() information, and then sort it by filename.  Bear in
   mind that DIRECTORY() returns an array containing one array for
   each file:

       Array Element    Information      Manifest Constant
                                         (in DIRECTRY.CH)
             1           file name            F_NAME
             2           file size            F_SIZE
             3           file date            F_DATE
             4           file time            F_TIME
             5           attribute            F_ATTR

   In Summer '87, we must rely upon the soon-to-be-put-out-to-pasture
   ADIR() function, which requires that we establish an array for each
   piece of information that we want to capture.

   * sort a directory listing by filename
   * first in Summer '87
   private files_[adir("*.*")]
   adir("*.*", files_)
   asort(files_)

   * then in 5.0
   local files_ := directory("*.*")
   asort(files_,,, { | x, y | x[1] < y[1] } )

   Now let's sort the directory by date:

   * Summer '87
   private files_[adir("*.*")], dates_[adir("*.*")]
   adir("*.*", files_, "", dates_)
   asort(dates_)

   * 5.0
   local files_ := directory("*.*")
   asort(files_,,, { | x, y | x[3] < y[3] } )

   You can see that the Summer '87 code has become increasingly
   convoluted as we add arrays to capture the other information.
   Not only that, but when we sort the DATES_ array, the FILES_ array
   (which contains the filenames) is left unchanged, thus undercutting
   our best efforts.  By stark contrast, we only needed to change two
   digits in the 5.0 code, and did not have to worry about sorting one
   array while leaving another untouched.

   For the grand finale, let's sort them again by date and name.

   * Summer '87
   * I give up!

   * 5.0
   local files_ := directory("*.*")
   asort(files_,,, { | x, y | if( x[3] = y[3], x[1] < y[1], ;
                                               x[3] < y[3] ) } )
   aeval(files_, { | a | qout(padr(a[1], 14), a[3]) } )

   (Note the use of PADR() to ensure that all the filenames line up!)

   Because of the wonderful DIRECTORY() function, we can easily
   determine if the dates are the same (x[3] = y[3]).  If they
   are, then we will compare the file names (x[1] < y[1]).
   Otherwise, we compare the file dates (x[3] < y[3]).  Yes, it
   can be done in Summer '87, but it would be such a mess that I would
   be afraid to!

FIELDBLOCK(<field>)

   FIELDBLOCK() is the first of three new functions that return
   "set-get" code blocks. One of the biggest reasons to use this trio
   of functions is to preclude the use of the macro operator. (As you
   might already know, swearing off macros will make your programs run
   faster and look more svelte.)

   FIELDBLOCK() returns a code block for a specified field.  The
   parameter <field> is a character string representing the field name
   to refer to.  You can then either retrieve (get) or assign (set)
   the value of <field> by evaluating the code block returned by
   FIELDBLOCK().  If <field> does not exist in the currently active
   work area, FIELDBLOCK() will return NIL.

   Note: if the <field> that you pass to FIELDBLOCK() exists in more
   than one work area, FIELDBLOCK()'s return value will correspond
   only to the <field> in the current area.

   Here's an example of retrieving the value:

   local bblock, mfield := "FNAME"
   dbcreate("customer", { { "FNAME", "C", 10, 0 } })
   use customer
   append blank
   customer->fname := "JOE"
   bblock := fieldblock(mfield)
   ? eval(bblock)     // displays "JOE"
   /* note the dreaded macro alternative */
   ? &mfield          // slow, and simply no longer chic

   To assign a value to a field, you merely evaluate the code block
   and pass the desired value as a parameter.  For example:

   local bblock, mfield := "FNAME"
   use customer
   bblock := fieldblock(mfield)
   eval(fieldblock(mfield), "Jennifer")
   ? customer->fname     // output: "Jennifer"
   /* note the dreaded macro alternative */
   replace &mfield with "Jennifer"  // ugh!

   The function STRUCT() loops through the structure array created by
   DBSTRUCT() and uses FIELDBLOCK() to retrieve the value for each
   field in your database.

   function struct(dbf_file)
   local struct, x
   if dbf_file == NIL
      qout("Syntax: struct <dbf_name>")
   elseif ! file(dbf_file) .and. ! file(dbf_file + ".dbf")
      qout("Could not open " + dbf_file)
   else
      use (dbf_file)
      struct := dbstruct()
      qout("Field Name Type Len Dec Contents of First Record")
      for x := 1 to len(struct)
         qout(padr(struct[x, 1], 10), padr(struct[x, 2], 4), ;
              str(struct[x, 3], 3), str(struct[x, 4], 3),    ;
              eval(fieldblock(struct[x, 1])) )
      next
      use
   endif
   return nil

   FLYPAPER: Version 1.03 (currently available at press time) requires
   the <field> to be defined at the time that you call FIELDBLOCK().
   This means that if you changed the code to create the block before
   opening the database that contained the field:

   * assume no databases are open
   bblock := fieldblock("FNAME")
   use customer

   your program will crash with an EVAL() error.  However, you should
   expect this situation to be corrected with the next release.

FIELDWBLOCK(<field>, <work area>)

   FIELDWBLOCK() is quite similar to FIELDBLOCK().  However, as you
   may have already surmised from the "W" in its name, it allows you
   to refer to a different work area to retrieve or assign the <field>
   value. As with FIELDBLOCK(), the <field> parameter is a character
   string representing the field name to refer to.

   The new parameter <work area> is a numeric indicating which work
   area to look for the <field>.

   Once again, you can then either retrieve or assign the value of
   <field> by evaluating the code block returned by FIELDWBLOCK().  If
   <field> does not exist in the specified <work area>, FIELDWBLOCK()
   will return NIL.  (Note: FIELDWBLOCK() does not change the active
   work area.)

   Here's FIELDWBLOCK() in action.  Note the use of the SELECT()
   function to determine the work areas; this is infinitely preferable
   to hard-coding (and then having to remember) work area numbers.

   dbcreate("customer", { { "LNAME", "C", 10, 0 } })
   dbcreate("vendor", { { "LNAME", "C", 10, 0 } })
   use customer new
   append blank
   customer->lname := "CUSTOMER1"
   use vendor new
   append blank
   vendor->lname := "VENDOR1"
   ? eval(fieldwblock("LNAME", select("customer"))) // CUSTOMER1
   ? eval(fieldwblock("LNAME", select("vendor")))   // VENDOR1
   ? eval(fieldwblock("LNAME", select("vendor")), "Grumpfish")
   ? vendor->lname                                  // Grumpfish

   As with FIELDBLOCK(), it is quite easy to assign a value to a
   field.  Simply evaluate the code block returned by FIELDWBLOCK()
   and pass the desired value as a parameter.  This is how I changed
   the field LNAME in VENDOR.DBF in the next-to-last line above.

   Last month we showed an example of creating a generic TBrowse object
   to browse a database. FIELDWBLOCK() offers a different solution:

   <M>local x, browse := TBrowseDB(3, 19, 15, 60), column
   use test
   for x := 1 to fcount()
      column := TBColumnNew(field(x), fieldwblock(field(x), select()))
      browse:AddColumn( column )
   next<M>

   FLYPAPER: In exactly the same fashion as for FIELDBLOCK(),
   version 1.03 (currently available at press time) requires the
   <field> to be defined at the time that you call FIELDWBLOCK().
   If not, your program will crash with an EVAL() error.  However, you
   should expect this situation to be corrected with the next release.

   In addition to this idiosyncrasy, FIELDWBLOCK() has problems when
   the <field> is not available in the current work area (regardless
   of which <work area> you specified).  If you specify a <work area>
   other than the current work area, and the <field> is not defined in
   the current work area but is defined in the specified <work area>,
   FIELDWBLOCK() will mistakenly return NIL.  I admit that this is a
   bit confusing, so let me illustrate it with a code snippet:

   dbcreate("customer", { { "LNAME", "C", 10, 0 } })
   dbcreate("vendor", { { "LNAME", "C", 10, 0 } })
   use customer new                 // we are now in area 1
   use vendor new                   // we are now in area 2
   ? eval(fieldwblock("LNAME", 1))  // this works flawlessly
   select 0                         // we are now in area 3
   ? eval(fieldwblock("LNAME", 1))  // ouch!!

   When you attempt to EVALuate that last line, your program will
   crash gracelessly with the soon-to-be-infamous EVAL() internal
   error 612.

   However, expect both of these problems to be corrected with the
   next release of Clipper 5.0.

MEMVARBLOCK(<memvar>)

   MEMVARBLOCK() is also quite similar to FIELDBLOCK(), except that it
   operates upon memory variables rather than database fields.
   MEMVARBLOCK() returns a code block for a memory variable as
   specified by the <memvar> parameter.  You can then either retrieve
   the value of <memvar> by evaluating the code block returned by
   MEMVARBLOCK(), or assign <memvar> a value by evaluating the code
   block and passing the value as a parameter.

   If the <memvar> does not exist, MEMVARBLOCK() will return NIL.
   Important Note: if the <memvar> is either STATIC or LOCAL,
   MEMVARBLOCK() will also return NIL.  This is because MEMVARBLOCK()
   can only operate on variables whose names are known at run-time
   (namely, PRIVATEs and PUBLICs).

   In this example, MEMVARBLOCK() retrieves the value of each of four
   memory variables.

   // note PRIVATE declaration -- MEMVARBLOCK() doesn't like LOCALs
   private mtot1 := 75, mtot2 := 400, mtot3 := 30, mtot4 := 205, x
   for x := 1 to 4
      ? eval(memvarblock("mtot" + str(x, 1)))
   next

SETKEY(<key>, [<block>])

   If you used the Summer '87 SET KEY command to establish "hot-key"
   procedures, you may have been frustrated at the inability to
   elegantly manage your hot keys.  For example, if you wanted to turn
   off all hot keys while the user was in a hot key procedure, it
   required a certain degree of tedious coding.

   Hot key procedures are yet another area where Clipper 5.0 gives you
   unprecedented control.  Whenever you establish a "hot-key"
   procedure with the SET KEY command, you are basically attaching a
   code block to that keypress with the new SETKEY() function.

   SETKEY() allows you to poll any INKEY() value to determine whether
   a code block is attached to it.  Like the other SET() functions, it
   also permits you to change the current setting, i.e., attach a code
   block to any key.

   The <key> parameter is a numeric corresponding to the INKEY() value
   of the keypress.  (Please refer to your Clipper documentation, or
   header file INKEY.CH, for a complete listing of INKEY() values.)

   The optional <block> parameter is the code block to be evaluated if
   the <key> is pressed during a wait state.  Wait states include
   ACHOICE(), DBEDIT(), MEMOEDIT(), ACCEPT, INPUT, READ, WAIT, and
   MENU TO.  (See below for discussion on INKEY(), the black sheep of
   the wait state family.)

   SETKEY() either returns a code block if one is tied to the <key>,
   or NIL.  If you pass the <block> parameter, it will attach that
   code block to the <key>.

   The SET KEY command

   Before I show you any SETKEY() examples, let us first look at how
   the SET KEY command is handled in 5.0:

   set key 28 to helpdev

   gets translated by the preprocessor into the following:

   SetKey( 28, {|p, l, v| helpdev(p, l, v)} )

   The P, L, and V parameters correspond to PROCNAME() (procedure
   name), PROCLINE() (current source code line number), and READVAR()
   (variable name), which will automatically be passed to the code
   block when it is evaluated. (Yes indeed, these are the same
   parameters passed to hot key procedures in Summer '87.) However,
   you can omit these arguments in your code block declaration if you
   will not be using them therein. By the same token, you are
   completely free to pass entirely different parameters to the
   function. (I'll use this technique to pass local variables via code
   blocks a bit later.)

   Whenever you come to a Clipper wait state, your keypress will be
   evaluated in approximately this fashion to determine whether or not
   there is a hot-key procedure tied to it:

   keypress := inkey(0)
   if setkey(keypress) != NIL
      eval(setkey(keypress))
   endif

   SETKEY() := Better Housekeeping

   Here is a good example.  Suppose that within a hot key procedure
   you wish to temporarily attach a hot key definition to the F10
   keypress.  However, you may have F10 activating various different
   procedures throughout the course of your program.  In Summer '87,
   this presented a big problem because you were unable to determine
   what procedure was tied to F10, and you would therefore be unable
   to change it and expect to reset it properly.  This is no longer a
   problem with SETKEY().  In this example, we redefine F10 to call
   BLAHBLAH(), and reset it when we are finished.

   #include "inkey.ch"     // for INKEY() constants
   function test(p, l, v)
   local old_f10 := setkey(K_F10, { | p,l,v | blahblah(p, l, v)} )
   * main code goes here
   setkey(K_F10, old_f10)                // restore F10 hot key
   return nil

   OLD_F10 is assigned the code block (if any) that is attached to
   F10.  F10 is then reassigned to trigger BLAHBLAH().  When we
   prepare to exit, we re-attach the previous code block (stored in
   OLD_F10) to the F10 keypress.  (Once again, please remember that
   you can omit the P, L, V arguments in your code block declaration
   if you will not be using them in the hot key function.)

   Important Note: before you go hog wild with hot keys, you should
   know that there are a limit of 32 SETKEY() (or SET KEY, same
   difference) procedures at any given time.

   INKEY() := Wait State?

   As with Summer '87, INKEY() is not a bona fide wait state.  But as
   you have just seen, SETKEY() makes it very easy to create your own
   INKEY() wait state.  Here's GINKEY() from the Grumpfish Library:

   //   GINKEY(<delay>) - INKEY() wait state
   //   Copyright (c) 1990 Greg Lief
   function ginkey(waittime)
   local key := inkey(waittime), cblock
   cblock := setkey(key)
   if cblock != NIL  // there is a code block for this key
      eval(cblock, procname(1), procline(1), 'ginkey')
   endif
   return key

   As mentioned earlier, the third parameter passed to hot key
   procedures is the name of the variable being read. In this
   function, "GINKEY" is serving as a dummy variable name. Please feel
   free to change it to anything you desire. If you really wanted to,
   you could pass a variable name as a second parameter to GINKEY(),
   and in turn pass that to the code block if/when it was evaluated.

   Notice that when the code block is evaluated, instead of passing it
   the current procedure name and line number, I pass it the
   information that is one level previous on the activation stack.
   (I'll discuss the activation stack in more detail in the March
   Aquarium.)  Otherwise, the hot key procedure would always think
   that it had just come from GINKEY().  This would in turn louse
   things up by forcing you to have the same help screen for every
   GINKEY() wait state.  In fact, there is a problem in Clipper 5.0
   related to the MENU TO wait state, which brings us to the next
   topic of discussion.

   MENU TO Caveat

   When you trigger a hot-key procedure from a MENU TO statement, the
   wrong PROCNAME() will be sent to the code block.

   function main
   local sel
   set key 28 to test
   cls
   @ 12,0 prompt "option 1"
   @ 13,0 prompt "option 2"
   @ 14,0 prompt "option 3"
   @ 15,0 prompt "option 4"
   menu to sel
   return nil

   function test(p,l,v)
   ? p            // __MENUTO (wrong)
   ? procname(1)  // (b)MAIN
   ? procname(2)  // __MODALKEY
   ? procname(3)  // __MENUTO
   ? procname(4)  // MAIN     (right)
   inkey(0)
   return nil

   To determine the proper name where the MENU TO statement is
   located, you must jump back by four levels of nesting. You can see
   that the procedure name is off by one level of nesting. Instead of
   PROCNAME(3), the MENU wait state should be sending PROCNAME(4) to
   the code block.

   Let's have a closer look at the callstack created by the MENU TO
   command. The first procedure name represents where the code block
   was actually created. The "(b)" prefix denotes that the procedure
   name is part of the callstack only because Clipper had to jump back
   momentarily to review the definition of the code block. (Remember
   this when you see "(b)" in conjunction with a run-time error.)

   The second procedure name is __MODALKEY, an internal Clipper
   function that apparently processes keystrokes. The third is
   __MENUTO, which is mistakenly passed to any hot key procedures
   triggered from its wait state.

   Here is the official Nantucket workaround.  Place this at the top
   of any procedure that is likely to be executed from setkey():

   function whatever(cproc, nline, cvar)
   if procname(3) == "__MENUTO"
     cproc := procname(4)
   else
     cproc := procname(3)
   endif

   Here is another suggestion that makes use of the preprocessor.
   Place the following in a header (.CH) file:

   #translate FIXMENU(<proc>, <line>) => ;
      <proc> := procname(if(procname(3) = '__MENUTO', 4, 3)) ;;
      <line> := procline(if(procname(3) = '__MENUTO', 4, 3))

   Then be sure to include this header file and the following line at
   the top of your setkey() procedures:

   #include "whatever.ch"

   function help(p, l, v)
   FIXMENU(p, l)
   etcetera

Passing LOCAL Variables in a Code Block

You and I both know that the scope of a LOCAL variable is the
procedure or function in which it is declared.  But there is actually
a way to pass a LOCAL to a different function.  It requires the use of
a code block.  Watch this!

   function main
   local bblock := { | | x }, x := 500
   test1(bblock)
   return nil

   function test1(b)
   ? eval(b)   // output: 500
   return nil

When BBLOCK is compiled in MAIN(), it will contain a reference to X,
which is a variable local to MAIN().  However, when the block BBLOCK
is passed as a parameter to TEST1(), and subsequently evaluated
therein, X's value will indeed be available.

Mind you, I do not advocate the unmitigated use of this technique.
It does not seem to be exactly what the architects had in mind for
LOCAL variables, eh?  But one situation comes to mind where this
method saved the day for me.  I wanted to GET a variable, and allow
the user to press a hot key to pop up a list of valid entries.  This
sounds pretty simple, doesn't it?  It would be, except that the
variable in question was LOCAL and thus restricted in scope to the
function in which I was GETting it.  What to do... what to do?  Here
is how I solved the problem with the clever use of a code block:

  #include "inkey.ch"
  #include "box.ch"

  function test
  local mvalue := space(7), oldaltv, x
  memvar getlist
  if ! file("lookup.dbf")
     dbcreate("lookup", { { "LNAME", "C", 7, 0 } } )
     use lookup
     for x := 1 to 9
        append blank
        /* note use of unnamed array -- it works just fine this way */
        replace lookup->lname with { "BOOTH", "DONNAY", "FORCIER", ;
             "LIEF", "MAIER", "MEANS", "NEFF", "ROUTH", "YELLICK" }[x]
     next
  else
     use lookup
  endif
  /* note that I pass MVALUE by reference to VIEW_VALS() below */
  oldaltv := setkey( K_ALT_V, {| | View_Vals(@mvalue)} )
  setcolor('+gr/b')
  cls
  @ 4, 28 say "Enter last name:" get mvalue
  setcolor('+w/b')
  @ 5, 23 say '(press Alt-V for available authors)'
  read
  quit

  static function view_vals(v)
  local browse, column, key, marker := recno(),                   ;
        oldscrn := savescreen(8, 35, 20, 44, 2),                  ;
        oldcolor := setcolor("+W/RB"), oldcursor := setcursor(0), ;
        oldblock := setkey( K_ALT_V, NIL )  // turn off ALT-V
  @ 8, 35, 20, 44 box B_SINGLE + chr(32)
  browse := TBrowseDB(9, 36, 19, 43)
  browse:headSep := "═"
  browse:colorSpec := '+W/RB, +W/N'
  column := TBColumnNew( "Author", FieldBlock("lname") )
  browse:addColumn(column)
  go top
  do while .t.
     do while ! browse:stabilize() .and. (key := inkey()) = 0
     enddo
     if browse:stable
        key := inkey(0)
     endif
     do case
        case key == K_UP
           browse:up()
        case key == K_DOWN
           browse:down()
        case key == K_ESC .or. key == K_ENTER
           exit
     endcase
  enddo
  if lastkey() != K_ESC
     /*
       because we passed the variable BY REFERENCE in the code block,
       any changes we make here are being made to the actual variable,
       and that is the key to this whole mess working the way it does!
     */
     v := eval(fieldblock('lname'))
  endif
  go marker
  restscreen(8, 35, 20, 44, oldscrn)
  setcolor(oldcolor)
  setcursor(oldcursor)
  setkey(K_ALT_V, oldblock)   // reset Alt-V for next time
  return nil

Conclusion

I certainly hope that this article has shattered any mental blocks that
you may have had about code blocks. Like it or not, code blocks are an
integral (and inescapable) part of Clipper 5.0.  Even if you never
explicitly write a code block in your code, you can bet that the
preprocessor will be turning your commands into code blocks, so you
might as well grin and bear it, and learn how to use code blocks to your
great advantage. As with most things in Clipper 5.0, your imagination
should be your only limit when dealing with code blocks.

About The Author

Greg Lief is co-authoring a book on Clipper 5.0 with Craig Yellick and
Joe Booth for Howard Sams.